//	COPYRIGHT (C) 1981 BY BOARD OF TRUSTEES,
//	LELAND STANFORD JUNIOR UNIVERSITY

//APRIL 25, 1978
//BCPL-CONGEN, WRITTEN BY RAY CARHART.  THIS IS THE DRAWING PACKAGE
//FOR TYPING CHEMICAL STRUCTURES TO THE TELETYPE.  INPUT IS FROM
//CGPASS.DAT.
GET "BCPLIB.GET"
GET "MYLIB.GET"

STATIC $( INTRPT.INTFLG = NIL; TRMTYP.NTERM = NIL; OUTPAD.IPADSZ = 63;
          OUTPAD.IPAD = VEC 3969; INFILE = NIL $);

LET INRUPT(X) BE !X:=0;

LET QUIT() BE FINISH;

LET INNON(SZ) = VALOF
 $( LET ANS,CH,SIGN=0,NIL,1;
 FOR I=1 TO SZ DO
  $(
  CH:=INCH();
  SWITCHON CH INTO
   $(
   CASE '*C': INCH(); RESULTIS MINUSINF; ENDCASE;
   CASE '-': SIGN:=-SIGN; ENDCASE;
   CASE ' ': CH:='0';
   DEFAULT: ANS:=10*ANS+CH-'0'
   $)
  $);
 RESULTIS SIGN*ANS
 $);

LET INNONL(SZ,NV,V) = VALOF
 $( STATIC $( NUM = NIL; CH = NIL $);
 FOR I=1 TO NV DO V!I:=0;
 FOR I=1 TO NV DO
  $(
  NUM:=INNON(SZ);
  IF NUM=MINUSINF DO RESULTIS TRUE;
  V!I:=NUM
  $);
 IF INNON(SZ)=MINUSINF DO RESULTIS TRUE;
 NUM:=INNON(SZ) REPEATUNTIL NUM=MINUSINF;
 RESULTIS FALSE
 $);

LET SETUP(N,ICON,ITOP,X,Y,Z) = VALOF
 $(
 STATIC $( NT = NIL; ZT = NIL; I6 = NIL; JT = NIL;
           INDEX = NIL; IT = NIL; J = NIL; I = NIL; NZRO = NIL $);
 STATIC $( AR = VEC 500; SUCC = NIL $);
 GET "FDRAW.BCL"
 INDEX:=[N*[N-1]]/2;
 I:=0;
 WHILE I<INDEX DO $( I+:=1; ITOP!I:=0 $);
 I:=0;
 I6:=-6;
 WHILE I<N DO
  $(
  I+:=1;
  I6+:=6;
  J:=0;
  WHILE J<6 DO
   $(
   J+:=1;
   IT:=I;
   JT:=ICON![J+I6];
   IF JT=0 DO BREAK;
   IF IT<JT DO $( IT:=JT; JT:=I $);
   ITOP![[[IT-2]*[IT-1]]/2+JT]:=1
   $)
  $);
 ID2AR(N,ICON,AR);
 SUCC:=FDRAW(N,AR);

// * Following code added at Ray's suggestion 11/20/80:
 NZRO:=0;
 FOR I = 1 TO N DO
  IF (AR![3+10*[I-1]]=0) & (AR![4+10*[I-1]]=0) DO NZRO+:=1;
 IF NZRO>1 DO SUCC:=1;
// *

 TEST SUCC>0 THEN FOR I=1 TO N DO $( X!I:=0.0; Y!I:=0.0 $)
 OR
  FOR I=1 TO N DO
   $(
   X!I:=FLOAT(AR![3+10*[I-1]]) #/ 30.0;
   Y!I:=FLOAT(AR![4+10*[I-1]]) #/ 30.0
   $);
 ZT:=0.3;
 NT:=0;
 I:=0
 WHILE I<N DO
  $(
  I+:=1;
  J:=0;
  WHILE J<I DO
   $(
   J+:=1;
   NT+:=1;
   IF NT>N DO GOTO ALLDONE;
   IF X!NT #EQ 0.0 DO X!NT:=FLOAT(I);
   IF Y!NT #EQ 0.0 DO Y!NT:=FLOAT(J);
   X!NT#+:=FLOAT(I)#*0.01;
   Y!NT#+:=FLOAT(J)#*0.01;
   Z!NT:=ZT;
   ZT:=#-ZT
   $)
  $);
 ALLDONE:
 RESULTIS SUCC
 $);

LET TGLIN(IFRAME,IDIM,ICHAR,I1,J1,I2,J2) BE
 $( MANIFEST $( IATVAL = #4000000 $);
 STATIC $( FJD = NIL; IDEL = NIL; FJ = NIL; VAL = NIL;
           JT2 = NIL; FID = NIL; IFT = NIL; JD = NIL;
           JT1 = NIL; IT2 = NIL; IT1 = NIL; J = NIL;
           ID = NIL; JDEL = NIL; DEL = NIL; FI = NIL;
           I = NIL $);
 JDEL:=J2-J1;
 IDEL:=I2-I1;
 IF [JDEL+IDEL] GE 0 DO GOTO S2;
 IT1:=I2;
 IT2:=I1;
 JT1:=J2;
 JT2:=J1;
 JDEL:=-JDEL;
 IDEL:=-IDEL;
 GOTO S3;
 S2: IT1:=I1;
 IT2:=I2;
 JT1:=J1;
 JT2:=J2;
 S3: IF [JDEL-IDEL] GE 0 DO GOTO S7;
 J:=JT1;
 FJ:=FLOAT(J);
 VAL:=FJ;
 DEL:=FLOAT(JDEL)#/FLOAT(IDEL);
 JD:=1;
 IF DEL #LS 0.0 DO JD:=-1;
 FJD:=FLOAT(JD);
 I:=IT1;
 WHILE I<IT2 DO
  $(
  I+:=1;
  VAL:=VAL#+DEL;
  IF #ABS[FJ#+FJD#-VAL] #LE #ABS[FJ#-VAL] DO $( J+:=JD; FJ#+:=FJD $);
  IFT:=IFRAME+[I+[J-1]*IDIM];
  IF !IFT<IATVAL DO !IFT BITOR:=ICHAR
  $);
 RETURN;
 S7: I:=IT1;
 FI:=FLOAT(I);
 VAL:=FI;
 DEL:=FLOAT(IDEL)#/FLOAT(JDEL);
 ID:=1;
 IF DEL #LS 0.0 DO ID:=-1;
 FID:=FLOAT(ID);
 J:=JT1;
 WHILE J<JT2 DO
  $(
  J+:=1;
  VAL#+:=DEL;
  IF #ABS[FI#+FID#-VAL] #LE #ABS[FI#-VAL] DO $( I+:=ID; FI#+:=FID $);
  IFT:=IFRAME+[I+[J-1]*IDIM];
  IF !IFT<IATVAL DO !IFT BITOR:=ICHAR
  $)
 $);

LET PLANE(AA,BB,CC,AB,AC,BC,A,B,R,RBEST,I,IBEST) BE
 $( MANIFEST $( CRIT = 0.001 $);
STATIC $( AABB = NIL; DEN = NIL $);
 AABB:=AA#*BB;
 DEN:=AABB#-AB#*AB;
 IF [DEN#/AABB] #LS CRIT DO RETURN;
 !A:=[AC#*BB#-AB#*BC]#/DEN;
 !B:=[AA#*BC#-AB#*AC]#/DEN;
 !R:=CC#+A#*A#*AA#+B#*B#*BB#+2.0#*!A#*B#*AB#-A#*AC#-B#*BC#+1.0;
 IF [!RBEST #GR 0.0] BITAND [!R #GE !RBEST] DO RETURN;
 !RBEST:=!R;
 !IBEST:=I;
 $);

LET SELEKT(ARRAY,PTRS,NPTRS,SELECT,TRAN) = VALOF
 $( STATIC $( ARYSAV = VEC 8; USED = VEC 8; PTRSAV = VEC 8;
              FLAGSV = VEC 8; NSEL = NIL $);
 STATIC $( PTR = NIL; TRNFLG = NIL; SELPTR = NIL; LVL = NIL;
           ARYVAL = NIL; I = NIL $);
 I:=0;
 WHILE I<NPTRS DO $( I+:=1; USED!I:=0 $);
 NSEL:=0;
 LVL:=1;
 SELPTR:=0;
 S1: TRNFLG:=PTRS!LVL;
 PTR:=TRNFLG-1;
 IF TRNFLG LE 0 DO PTR:=-TRNFLG-1;
 S2: PTR:=PTR+1;
 ARYVAL:=ARRAY!PTR;
 IF ARYVAL EQ 0 DO GOTO S5;
 IF TRNFLG LE 0 DO ARYVAL:=TRAN!ARYVAL;
 IF USED!ARYVAL EQ 1 DO GOTO S2;
 ARYSAV!LVL:=ARYVAL;
 IF LVL EQ NPTRS DO GOTO S3;
 USED!ARYVAL:=1;
 PTRSAV!LVL:=PTR;
 FLAGSV!LVL:=TRNFLG;
 LVL:=LVL+1;
 GOTO S1;
 S3: NSEL:=NSEL+1;
 I:=0;
 WHILE I<NPTRS DO
  $(
  I+:=1;
  SELPTR:=SELPTR+1;
  SELECT!SELPTR:=ARYSAV!I
  $);
 GOTO S2;
 S5: LVL:=LVL-1;
 IF LVL EQ 0 DO RESULTIS NSEL;
 PTR:=PTRSAV!LVL;
 TRNFLG:=FLAGSV!LVL;
 USED![ARYSAV!LVL]:=0;
 GOTO S2
 $);

LET STATES(STATE,REENT,NEDGES,NODE1,NODE2,
           VI1M1,VI2M1,STPTRS,STARY,N1,VALENC) = VALOF
 $( STATIC $( N2DSV = VEC 70; PTRSV = VEC 70; REFLCT = TABLE 0,5,6,7,8,
              1,2,3,4; ANS = NIL $);
 STATIC $( PTR = NIL; N2DIR = NIL; EDGE = NIL; POPNUM = NIL;
           STCNT = NIL; NOD2 = NIL; NOD1 = NIL; I = NIL $);
 MANIFEST $( POPMAX = 100 $);
 ANS:=0;
 IF REENT EQ 1 DO GOTO S5;
 POPNUM:=0;
 I:=0;
 WHILE I<50 DO $( I+:=1; STATE!I:=0 $);
 I:=0;
 S100: I:=I+1;
 IF I>N1 DO RESULTIS ANS;
 STATE![NODE1!1]:=I;
 EDGE:=0;
 S1: EDGE:=EDGE+1;
 IF EDGE LE NEDGES DO GOTO S14;
 ANS:=1;
 RESULTIS ANS;
 S14: NOD1:=NODE1!EDGE;
 NOD2:=NODE2!EDGE;
 N2DIR:=STARY![STPTRS!NOD1+[STATE!NOD1-1]*VALENC!NOD1+VI1M1!EDGE];
 N2DIR:=REFLCT!N2DIR;
 PTR:=[STATE!NOD2-1]*VALENC!NOD2+VI2M1!EDGE;
 IF PTR<0 DO GOTO S15;
 IF N2DIR NE STARY![PTR+STPTRS!NOD2] DO GOTO S5;
 PTRSV!EDGE:=-1;
 GOTO S1;
 S15: PTR:=STPTRS!NOD2+PTR;
 STCNT:=0;
 S2: PTR:=PTR+VALENC!NOD2;
 STCNT:=STCNT+1;
 IF PTR GE STPTRS![NOD2+1] DO GOTO S5;
 IF N2DIR NE STARY!PTR DO GOTO S2;
 STATE!NOD2:=STCNT;
 PTRSV!EDGE:=PTR;
 N2DSV!EDGE:=N2DIR;
 GOTO S1;
 S5: EDGE:=EDGE-1;
 IF EDGE EQ 0 DO GOTO S100;
 POPNUM:=POPNUM+1;
 IF POPNUM>POPMAX DO RESULTIS ANS;
 PTR:=PTRSV!EDGE;
 IF PTR<0 DO GOTO S5;
 NOD2:=NODE2!EDGE;
 N2DIR:=N2DSV!EDGE;
 STCNT:=STATE!NOD2;
 STATE!NOD2:=0;
 GOTO S2
 $);

LET GSTRAT(STRAT,STATE,NNODES,VALENC,STARY,
           STPTRS,NEDGES,NODE1,NODE2,DIST,BCON) BE
 $( STATIC $( IUSED = VEC 50; FACTOR = TABLE 0.0,2.0,1.414,2.0,1.414,
              2.0,1.414,2.0,1.414 $);
 STATIC $( INC = NIL; STRATP = NIL; STARYP = NIL; IDIS = NIL;
           BONDIR = NIL; EDGE = NIL; NOD2 = NIL; NOD1 = NIL;
           RELDIS = NIL; I = NIL $);
 I:=0;
 WHILE I<NNODES DO $( I+:=1; IUSED!I:=0 $);
 NOD1:=NODE1!1;
 IUSED!NOD1:=1;
 STRAT!1:=NOD1;
 STRATP:=2;
 EDGE:=0;
 WHILE EDGE<NEDGES DO
  $(
  EDGE+:=1;
  NOD1:=NODE1!EDGE;
  NOD2:=NODE2!EDGE;
  STARYP:=STPTRS!NOD1+VALENC!NOD1*[STATE!NOD1-1];
  I:=0;
  WHILE I<8 DO
   $(
   I+:=1;
   IF EDGE=BCON![I+[[NOD1-1]<<3]] DO BREAK;
   STARYP+:=1
   $);
  BONDIR:=STARY!STARYP;
  STRAT!STRATP:=NOD1;
  STRAT![STRATP+1]:=BONDIR;
  STRATP:=STRATP+3;
  STRAT![STRATP-1]:=NOD2;
  IF IUSED!NOD2=0 DO GOTO S4;
  STRAT!STRATP:=0;
  STRATP:=STRATP+1;
  LOOP;
  S4: IUSED!NOD2:=1;
  RELDIS:=FACTOR!BONDIR#*DIST!EDGE;
  IDIS:=FIX(RELDIS);
  IF IDIS LE 2 DO GOTO S5;
  INC:=-1;
  IF RELDIS GE FLOAT!IDIS DO INC:=1;
  STRAT!STRATP:=IDIS;
  STRAT![STRATP+1]:=IDIS+INC;
  STRAT![STRATP+2]:=IDIS-INC;
  STRAT![STRATP+3]:=0;
  STRATP:=STRATP+4;
  LOOP;
  S5: STRAT!STRATP:=2;
  STRAT![STRATP+1]:=3;
  STRAT![STRATP+2]:=0;
  STRATP:=STRATP+3
  $);
 STRAT!STRATP:=0
 $);

LET TRYDRW(STRAT,PAD,PADSIZ,LOC,MULTIP,X0,Y0) = VALOF
 $( STATIC $( PUSH1 = VEC 70; PUSH2 = VEC 70; PUSH3 = VEC 70;
              PUSH4 = VEC 70; PUSH5 = VEC 70; PUSH6 = VEC 70;
              PUSH7 = VEC 70; PUSH8 = VEC 70; BONCOD = TABLE 0,1,2,4,
              8,1,2,4,8; BONDX = TABLE 0,1,1,0,-1,-1,-1,0,1; BONDY =
              TABLE 0,0,1,1,1,0,-1,-1,-1; OFFSET = TABLE 0,1,16,256,
              4096,#200000 $);
 STATIC $( STRPTR = NIL; TOOLNG = NIL; BEGIN = NIL; DIST = NIL;
           DX = NIL; TEMPXY = NIL; ATOM2 = NIL; BASEXY = NIL;
           BCODE = NIL; PADDIM = NIL; ATOM1 = NIL; PADSP = NIL;
           DELPAD = NIL; LVL = NIL; POPNUM = NIL; MIDPAD = NIL;
           DELXY = NIL; POPRET = NIL; PADSM = NIL; BOND = NIL;
           I = NIL; DY = NIL $);
 MANIFEST $( ATVAL = #4000000; POPMAX = 100 $);
 PADDIM:=PADSIZ*PADSIZ;
 MIDPAD:=[PADDIM+1]/2;
 TOOLNG:=PADSIZ/2;
 POPNUM:=0;
 PADSM:=PADSIZ-1;
 PADSP:=PADSIZ+1;
 LVL:=0;
 STRPTR:=1;
 BEGIN:=MIDPAD+FIX(Y0)*PADSIZ+FIX(X0);
 LOC![STRAT!1]:=BEGIN;
 PAD!BEGIN:=ATVAL*STRAT!1;
 S1: STRPTR:=STRPTR+1;
 ATOM1:=STRAT!STRPTR;
 IF ATOM1 NE 0 DO GOTO S3;
 RESULTIS 1
 S3: BOND:=STRAT![STRPTR+1];
 ATOM2:=STRAT![STRPTR+2];
 STRPTR:=STRPTR+2;
 BASEXY:=LOC!ATOM1;
 BCODE:=BONCOD!BOND;
 DELPAD:=BONDY!BOND*PADSIZ+BONDX!BOND;
 IF STRAT![STRPTR+1]=0 DO GOTO S19;
 BCODE:=BCODE*OFFSET![MULTIP![LVL+1]];
 S4: STRPTR:=STRPTR+1;
 DIST:=STRAT!STRPTR;
 IF DIST=0 DO GOTO S200;
 DIST:=DIST-1;
 TEMPXY:=BASEXY+DIST*DELPAD;
 IF [[TEMPXY+PADSP]>PADDIM] BITOR [[TEMPXY-PADSP]<1] DO GOTO S4;
 TEMPXY:=BASEXY;
 I:=0;
 WHILE I<DIST DO
  $(
  I+:=1;
  TEMPXY:=TEMPXY+DELPAD;
  IF PAD!TEMPXY GE ATVAL DO GOTO S4
  $);
 TEMPXY:=TEMPXY+DELPAD;
 IF PAD!TEMPXY NE 0 DO GOTO S4;
 IF PAD![TEMPXY+1] GE ATVAL DO GOTO S4;
 IF PAD![TEMPXY-1] GE ATVAL DO GOTO S4;
 IF PAD![TEMPXY+PADSIZ] GE ATVAL DO GOTO S4;
 IF PAD![TEMPXY-PADSIZ] GE ATVAL DO GOTO S4;
 IF PAD![TEMPXY+PADSM] GE ATVAL DO GOTO S4;
 IF PAD![TEMPXY-PADSM] GE ATVAL DO GOTO S4;
 IF PAD![TEMPXY+PADSP] GE ATVAL DO GOTO S4;
 IF PAD![TEMPXY-PADSP] GE ATVAL DO GOTO S4;
 PAD!TEMPXY:=ATVAL*ATOM2;
 LOC!ATOM2:=TEMPXY;
 I:=0;
 WHILE I<DIST DO
  $(
  I+:=1;
  TEMPXY:=TEMPXY-DELPAD;
  PAD!TEMPXY:=PAD!TEMPXY+BCODE
  $);
 POPRET:=1;
 GOTO S100;
 S7: I:=0;
 WHILE I<DIST DO
  $(
  I+:=1;
  PAD!TEMPXY:=PAD!TEMPXY-BCODE;
  TEMPXY:=TEMPXY+DELPAD
  $);
 PAD!TEMPXY:=0;
 GOTO S4;
 S19: STRPTR:=STRPTR+1;
 DELXY:=LOC!ATOM2-LOC!ATOM1;
 DIST:=DELXY/DELPAD;
 IF DIST LE 1 DO GOTO S190;
 IF DIST GE TOOLNG DO GOTO S190;
 IF DIST*DELPAD=DELXY DO GOTO S199;
 S190: DY:=[DELXY+TOOLNG]/PADSIZ;
 IF DELXY<0 DO DY:=[DELXY-TOOLNG]/PADSIZ;
 DX:=DELXY-DY*PADSIZ;
 IF DX NE 0 DO GOTO S192;
 IF DY<0 DO GOTO S191;
 DELPAD:=PADSIZ;
 DIST:=DY;
 BCODE:=4;
 GOTO S198;
 S191: DELPAD:=-PADSIZ;
 DIST:=-DY;
 BCODE:=4;
 GOTO S198;
 S192: IF DY NE 0 DO GOTO S194;
 IF DX<0 DO GOTO S193;
 DELPAD:=1;
 DIST:=DX;
 BCODE:=1;
 GOTO S198;
 S193: DELPAD:=-1;
 DIST:=-DX;
 BCODE:=1;
 GOTO S198;
 S194: DIST:=ABS[DX];
 IF DIST NE ABS[DY] DO GOTO S200;
 IF DX=DY DO GOTO S195;
 DELPAD:=PADSIZ-1;
 IF DY<0 DO DELPAD:=-DELPAD;
 BCODE:=8;
 GOTO S198;
 S195: DELPAD:=PADSIZ+1;
 IF DY<0 DO DELPAD:=-DELPAD;
 BCODE:=2;
 S198: IF DIST LE 1 DO GOTO S200;
 IF DIST GE TOOLNG DO GOTO S200;
 S199: DIST:=DIST-1;
 TEMPXY:=BASEXY;
 I:=0;
 WHILE I<DIST DO
  $(
  I+:=1;
  TEMPXY:=TEMPXY+DELPAD;
  IF PAD!TEMPXY GE ATVAL DO GOTO S200
  $);
 BCODE:=BCODE*OFFSET![MULTIP![LVL+1]];
 I:=0;
 WHILE I<DIST DO
  $(
  I+:=1;
  PAD!TEMPXY:=PAD!TEMPXY+BCODE;
  TEMPXY:=TEMPXY-DELPAD
  $);
 POPRET:=2;
 GOTO S100;
 S22: I:=0;
 WHILE I<DIST DO
  $(
  I+:=1;
  TEMPXY:=TEMPXY+DELPAD;
  PAD!TEMPXY:=PAD!TEMPXY-BCODE
  $);
 GOTO S200;
 S100: LVL:=LVL+1;
 PUSH1!LVL:=DIST;
 PUSH2!LVL:=TEMPXY;
 PUSH3!LVL:=DELPAD;
 PUSH4!LVL:=BCODE;
 PUSH5!LVL:=POPRET;
 IF POPRET=2 DO GOTO S1;
 PUSH6!LVL:=BASEXY;
 PUSH7!LVL:=ATOM2;
 PUSH8!LVL:=STRPTR;
 S101: STRPTR:=STRPTR+1;
 IF STRAT!STRPTR NE 0 DO GOTO S101;
 GOTO S1;
 S200: IF LVL=0 DO GOTO S300;
 POPNUM:=POPNUM+1;
 IF POPNUM>POPMAX DO GOTO S400;
 DIST:=PUSH1!LVL;
 TEMPXY:=PUSH2!LVL;
 DELPAD:=PUSH3!LVL;
 BCODE:=PUSH4!LVL;
 POPRET:=PUSH5!LVL;
 IF POPRET=1 DO GOTO S201;
 LVL:=LVL-1;
 GOTO S22;
 S201: BASEXY:=PUSH6!LVL;
 ATOM2:=PUSH7!LVL;
 STRPTR:=PUSH8!LVL;
 LVL:=LVL-1;
 GOTO S7;
 S300: PAD!BEGIN:=0;
 RESULTIS 0;
 S400: I:=0;
 WHILE I<PADDIM DO $( I+:=1; PAD!I:=0 $);
 RESULTIS 0
 $);

LET PUTSTK(NS,MS,RS,JS,N,M,R) BE
 $(
 STATIC $( JSP = NIL $);
 JSP:=!JS;
!JS+:=1;
 S1: IF JSP=0 DO GOTO S2;
 IF R #GR RS!JSP DO GOTO S3;
 S2: JSP:=JSP+1;
 RS!JSP:=R;
 NS!JSP:=N;
 MS!JSP:=M;
 RETURN;
 S3: RS![JSP+1]:=RS!JSP;
 NS![JSP+1]:=NS!JSP;
 MS![JSP+1]:=MS!JSP;
 JSP:=JSP-1;
 GOTO S1
 $);

LET PUTMUL(PAD,PADSIZ,LOC,NAMES,NODES) = VALOF
 $( STATIC $( INC = VEC 8; DELX = TABLE 0,1,1,0,-1,-1,-1,0,1;
              DELY = TABLE 0,0,1,1,1,0,-1,-1,-1; BPRIO = TABLE 0,1,1024,
              256,1024,0,1024,257,1024; PRIO = VEC 8; MODPOS = VEC 150;
              MODVAL = VEC 150 $);
 STATIC $( PRIOI = NIL; PDPOS2 = NIL; NMOD = NIL; NNAMES = NIL;
           PADPOS = NIL; NODE = NIL; BSTDIR = NIL; PADPTR = NIL;
           J = NIL; PRI = NIL; I = NIL; BSTVAL = NIL $);
 MANIFEST $( FULL = 1024; ATVAL = #4000000 $);
 NNAMES:=NODES;
 NMOD:=0;
 I:=0;
 WHILE I<8 DO
  $(
  I+:=1;
  INC!I:=DELX!I+PADSIZ*DELY!I
  $);
 NODE:=0;
 WHILE NODE<NODES DO
  $(
  NODE+:=1;
  IF NAMES![1+[[NODE-1]<<2]]=1 DO LOOP;
  PADPTR:=LOC!NODE;
  I:=0;
  WHILE I<8 DO
   $(
   I+:=1;
   PADPOS:=PADPTR+INC!I;
   IF PAD!PADPOS=0 DO GOTO S2;
   PRIOI:=FULL;
   GOTO S4;
   S2: PRIOI:=BPRIO!I-16;
   J:=0;
   WHILE J<8 DO
    $(
    J+:=1;
    PDPOS2:=PADPOS+INC!J;
    IF PAD!PDPOS2 NE 0 DO PRIOI:=PRIOI+16
    $);
   S4: PRIO!I:=PRIOI
   $);
  IF NAMES![1+[[NODE-1]<<2]] NE 2 DO GOTO S7;
  BSTVAL:=FULL;
  I:=0;
  WHILE I<8 DO
   $(
   I+:=1;
   IF BSTVAL LE PRIO!I DO LOOP;
   BSTVAL:=PRIO!I;
   BSTDIR:=I;
   $);
  IF BSTVAL=FULL DO GOTO S11;
  PADPOS:=PADPTR+INC!BSTDIR;
  NMOD+:=1;
  MODPOS!NMOD:=PADPOS;
  MODVAL!NMOD:=0;
  IF BSTDIR<4 DO GOTO S6;
  IF BSTDIR>7 DO GOTO S6;
  PAD!PADPOS:=ATVAL*NODE;
  PADPOS:=PADPTR;
  NMOD+:=1;
  MODPOS!NMOD:=PADPOS;
  MODVAL!NMOD:=PAD!PADPOS;
  S6: NNAMES+:=1;
  NAMES![2+[[NNAMES-1]<<2]]:=NAMES![3+[[NODE-1]<<2]];
  PAD!PADPOS:=ATVAL*NNAMES;
  LOOP;
  S7: BSTVAL:=PRIO!4+PRIO!8;
  BSTDIR:=4;
  I:=4;
  WHILE I<7 DO
   $(
   I+:=1;
   PRI:=PRIO!I+PRIO![I-4];
   IF BSTVAL LE PRI DO LOOP;
   BSTVAL:=PRI;
   BSTDIR:=I
   $);
  IF BSTVAL GE FULL DO GOTO S11;
  PADPOS:=PADPTR+INC!BSTDIR;
  NMOD:=NMOD+1;
  MODPOS!NMOD:=PADPOS;
  MODVAL!NMOD:=0;
  PAD!PADPOS:=ATVAL*NODE;
  I:=0;
  WHILE I<2 DO
   $(
   I+:=1;
   PADPOS:=PADPOS-INC!BSTDIR;
   NMOD:=NMOD+1;
   MODPOS!NMOD:=PADPOS;
   MODVAL!NMOD:=PAD!PADPOS;
   NNAMES:=NNAMES+1;
   NAMES![2+[[NNAMES-1]<<2]]:=NAMES![2+I+[[NODE-1]<<2]];
   PAD!PADPOS:=ATVAL*NNAMES
   $)
  $);
 RESULTIS 1;
 S11: IF NMOD=0 DO RESULTIS 0;
 I:=0;
 WHILE I<NMOD DO
  $(
  I+:=1;
  PAD![MODPOS!I]:=MODVAL!I
  $);
 RESULTIS 0
 $);

LET WRT33(LINE,LASTC) BE
 $( STATIC $( LOUT = VEC 80 $);
 STATIC $( LII = NIL; II = NIL; IBSFLG = NIL; LPT = NIL;
           LLC = NIL; I = NIL $);
 MANIFEST $( IVERT = '|'; IEXCL = '!'; IBLNK = ' '; IBACK = '*B' $);
 LLC:=0;
 II:=0;
 IBSFLG:=0;
 LPT:=0;
 S1: II:=II+1;
 IF II>LASTC DO GOTO S3;
 LII:=LINE!II;
 IF TRMTYP.NTERM=1 DO GOTO S11;
 IF LII=IVERT DO LII:=IEXCL;
 IF LII=IBACK DO GOTO S2;
 S11: LPT:=LPT+1;
 IF LII NE IBLNK DO LLC:=LPT;
 LOUT!LPT:=LII;
 GOTO S1;
 S2: II:=II+1;
 IBSFLG:=1;
 GOTO S1;
 S3: IF LLC=0 DO GOTO S4;
 I:=0;
 WHILE I<LLC DO $( I+:=1; OUTCH(LOUT!I) $);
 IF INTRPT.INTFLG NE 0 DO QUIT();
 S4: IF IBSFLG=0 DO $( NEWLINE(1); RETURN $);
 LLC:=0;
 IBSFLG:=0;
 II:=0;
 LPT:=0;
 S5: II:=II+1;
 IF II>LASTC DO GOTO S9;
 S6: LII:=LINE!II;
 IF LII=0 DO GOTO S5;
 IF LII=IBACK DO GOTO S7;
 LPT:=LPT+1;
 LOUT!LPT:=IBLNK;
 GOTO S5;
 S7: LII:=LINE![II+1];
 IF LII=IVERT DO LII:=IEXCL;
 LOUT!LPT:=LII;
 LINE!II:=0;
 LINE![II+1]:=0;
 IF LOUT!LPT NE IBLNK DO LLC:=LPT;
 S8: II:=II+2;
 IF II>LASTC DO GOTO S9;
 IF LINE!II NE IBACK DO GOTO S6;
 IBSFLG:=1;
 GOTO S8;
 S9: IF LLC=0 DO GOTO S4;
 OUTCH('*C');
 I:=0;
 WHILE I<LLC DO $( I+:=1; OUTCH(LOUT!I) $);
 IF INTRPT.INTFLG NE 0 DO QUIT();
 GOTO S4
 $);
MANIFEST $( PI = 3.14159265 $);
MANIFEST $( HALFPI = PI#/2.0 $);

LET SQRT(FNUM) = VALOF
//FNUM IS A FLOATING-POINT NUMBER, AS IS THE VALUE OF SQRT.
//TAKEN FROM THE FORTRAN-10 LIBRARY EXCEPT RETURNS 0.0 IF FNUM LE 0.0
 $[ $SKIPG 2,FNUM;
    $JRST ZO;
    $MOVE 1,2;
    $LSH 2,-1;
    $TLZE 2,#400;
    $JRST P1;
    $ADD 2,K;
    $FMPRI 2,#301454;
    $JRST P2;
P1: $ADD 2,K;
    $FMPRI 2,#301650;
P2: $FDV 1,2;
    $FAD 2,1;
    $FSC 2,-1;
    $MOVM 1,FNUM;
    $FDV 1,2;
    $FADR 1,2;
    $FSC 1,-1;
    $( RETURN $);
K:  $EXP #267607000;
ZO: $SETZM 0,1
  $];

LET ATAN(X) = VALOF
//ARCTANGENT ROUTINE TAKEN FROM THE FORTRAN-10 LIBRARY, WITH SOME
//MODIFICATIONS.  X IS A FLOATING-POINT NUMBER, VALUE IS A
//FLOATING POINT NUMBER IN THE RANGE [-PI/2,PI/2]
 $[ $MOVE 1,X;
    $MOVM 2,1;
    $CAMG 2,K1;
    $JRST P1;
    $HLLO 4,1;
    $CAML 2,K2;
    $JRST P2;
    $MOVSI 3,#201400;
    $CAMG 2,3;
    $TRZA 4,-1;
    $FDVM 3,2;
    $TLC 4,0(4);
    $MOVEM 2,5;
    $FMP 2,2;
    $MOVE 3,K3;
    $FAD 3,2;
    $MOVE 1,K4;
    $FDVM 1,3;
    $FAD 3,2;
    $FAD 3,K5;
    $MOVE 1,K6;
    $FDVM 1,3;
    $FAD 3,2;
    $FAD 3,K7;
    $MOVE 1,K8;
    $FDV 1,3;
    $FAD 1,K9;
    $FMP 1,5;
    $TRNE 4,-1;
    $FSB 1,K;
    $SKIPA 0;
P2: $MOVE 1,K;
    $SKIPGE 4;
    $MOVNS 1;
P1: $( RETURN $);
K1: $XWD #145000,,0;
K2: $XWD #233000,,0;
K9: $EXP #176545543401;
K7: $EXP #203660615617;
K5: $EXP #202650373270;
K3: $EXP #201562663021;
K8: $EXP #202732621643;
K6: $EXP #574071125540;
K4: $EXP #600360700773;
K:  $EXP #201622077325
 $];

LET ATAN2(Y,X) =
//THE ANGLE IN RADIANS BETWEEN THE +X AXIS AND THE POINT (X,Y),
//MEASURED ANTICLOCKWISE IN THE RANGE [PI,-PI).  X, Y AND THE
//VALUE OF ATAN2 ARE ALL FLOATING-POINT NUMBERS
 (X=0 -> (Y>0 -> HALFPI,-HALFPI),
         (Y=0 -> (X>0 -> 0,PI),
                 (X>0 -> ATAN(Y#/X),
                         (Y>0 -> PI#+ATAN(Y#/X), ATAN(Y#/X)#-PI))));

LET SETRT(DX,DY,THETA,R,RMIN) BE
 $( MANIFEST $( CONV = 57.3 $);
 !R:=SQRT(DX#*DX#+DY#*DY);
 IF !R #LS !RMIN DO !RMIN:=!R;
 !THETA:=CONV#*ATAN2(DY,DX);
 IF !THETA #LS 0.0 DO !THETA#+:=360.0
 $);

LET BONSET(ICON,CON,NODES,X,Y,NODE1,NODE2,MULTIP,DIST,
           POSBON,PBPTRS,BCON,VALENC,DELANG) = VALOF
 $( STATIC $( ANG = VEC 70; IUSED = VEC 50; N1STAK = VEC 70;
              N2STAK = VEC 70; TCON = VEC 6; TMCON = VEC 6;
              RSTAK = VEC 70; BANG = TABLE 0.0,-45.0,0.0,45.0,90.0,
              135.0,180.0,225.0,270.0,315.0,360.0,405.0; BNUM = TABLE 0,
              8,1,2,3,4,5,6,7,8,1,2; MCON = VEC 300; IFROM = VEC 50;
              ITO = VEC 50; NDSRNG = VEC 50 $);
 STATIC $( IFR = NIL; NSV = NIL; IV = NIL; PBPTR = NIL;
           NDRING = NIL; ANGMAX = NIL; STAKPT = NIL; K = NIL;
           IDIREC = NIL; ANGMIN = NIL; BANGJ = NIL; TRMIN = NIL;
           NBR = NIL; NBN = NIL; IT = NIL; NEWND = NIL;
           NUNIQ = NIL; J = NIL; MORCHN = NIL; NUNK = NIL;
           N2 = NIL; ITOTOP = NIL; NCESTR = NIL; NSTAK = NIL;
           DEL = NIL; IDEEP = NIL; I = NIL; N1 = NIL;
           ANGI = NIL; NBOND = NIL $);
 MANIFEST $( NDIREC = 11 $);
 TRMIN:=1.0E6;
 I:=0;
 WHILE I<NODES DO
  $(
  I+:=1;
  J:=0;
  WHILE J<6 DO
   $(
   J+:=1;
   TMCON!J:=1;
   TCON!J:=ICON![J+[I-1]*6]
   $);
  NUNIQ:=1;
  J:=1;
  WHILE J<6 DO
   $(
   J+:=1;
   NBR:=TCON!J;
   IF NBR=0 DO BREAK;
   K:=0;
   WHILE K<NUNIQ DO
    $(
    K+:=1;
    IF NBR NE TCON!K DO LOOP;
    TMCON!K:=TMCON!K+1;
    GOTO S27
    $);
   NUNIQ:=NUNIQ+1;
   TCON!NUNIQ:=NBR;
   S27:
   $);
  IF NUNIQ EQ 6 DO GOTO S276;
  NUNIQ:=NUNIQ+1;
  J:=NUNIQ-1;
  WHILE J<6 DO $( J+:=1; TCON!J:=0 $);
  S276: J:=0;
  WHILE J<6 DO
   $(
   J+:=1;
   CON![J+[I-1]*6]:=TCON!J;
   MCON![J+[I-1]*6]:=TMCON!J
   $)
  $);
 I:=0;
 WHILE I<NODES DO
  $(
  I+:=1;
  IUSED!I:=0;
  IF CON![2+[I-1]*6]=0 DO IUSED!I:=-1
  $);
 S51: MORCHN:=0;
 I:=0;
 WHILE I<NODES DO
  $(
  I+:=1;
  IF IUSED!I NE 0 DO LOOP;
  NUNK:=0;
  J:=0;
  WHILE J<6 DO
   $(
   J+:=1;
   NBR:=CON![J+[I-1]*6];
   IF NBR EQ 0 DO BREAK;
   IF IUSED!NBR=0 DO NUNK+:=1
   $);
  IF NUNK NE 1 DO LOOP;
  IUSED!I:=-1;
  MORCHN:=1;
  $);
 IF MORCHN NE 0 DO GOTO S51;
 NSTAK:=0;
 NDRING:=0;
 I:=0;
 WHILE I<NODES DO
  $(
  I+:=1;
  IF IUSED!I NE 0 DO LOOP;
  IF NDRING=0 DO NDRING:=I;
  J:=0;
  WHILE J<6 DO
   $(
   J+:=1;
   NBR:=CON![J+[I-1]*6];
   IF NBR=0 DO BREAK;
   IF IUSED!NBR=0 DO LOOP;
   NSTAK+:=1;
   IFROM!NSTAK:=I;
   ITO!NSTAK:=NBR;
   IUSED!NBR:=1
   $)
  $);
 I:=0;
 WHILE I<NODES DO
  $(
  I+:=1;
  IF IUSED!I=-1 DO IUSED!I:=0
  $);
 NCESTR:=0;
 IDEEP:=0;
 S57: NEWND:=0;
 IDEEP:=IDEEP+1;
 NDSRNG!IDEEP:=NDRING;
 IUSED!NDRING:=2;
 J:=0;
 WHILE J<6 DO
  $(
  J+:=1;
  NBR:=CON![J+[NDRING-1]*6];
  IF NBR=0 DO BREAK;
  IF NBR=NCESTR DO LOOP;
  IF IUSED!NBR=1 DO LOOP;
  IF IUSED!NBR=2 DO GOTO S60;
  NEWND:=NBR;
  $);
 IF NEWND=0 DO GOTO S625;
 NCESTR:=NDRING;
 NDRING:=NEWND;
 GOTO S57;
 S60: NDRING:=NBR;
 NSV:=NSTAK+1;
 J:=0;
 WHILE J<6 DO
  $(
  J+:=1;
  NBR:=CON![J+[NDRING-1]*6];
  IF NBR=0 DO BREAK;
  IF IUSED!NBR=1 DO LOOP;
  NSTAK+:=1;
  IFROM!NSTAK:=NDRING;
  ITO!NSTAK:=NBR
  $);
 I:=0;
 WHILE I<IDEEP DO
  $(
  I+:=1;
  TEST NDSRNG!I NE NDRING THEN IUSED![NDSRNG!I]:=0
  OR ITOTOP:=NDSRNG![I+1]
  $);
 I:=NSV-1;
 WHILE I<NSTAK DO
  $(
  I+:=1;
  IF ITO!I NE ITOTOP DO LOOP;
  ITO!I:=ITO!NSTAK;
  ITO!NSTAK:=ITOTOP;
  BREAK
  $);
 S625: NBOND:=0;
 S63: IF NSTAK=0 DO GOTO S105;
 IFR:=IFROM!NSTAK;
 IT:=ITO!NSTAK;
 NSTAK-:=1;
 IF IUSED!IT=2 DO GOTO S63;
 NBOND+:=1;
 NODE1!NBOND:=IFR;
 NODE2!NBOND:=IT;
 IUSED!IT:=2;
 NBN:=NBOND;
 J:=0;
 WHILE J<6 DO
  $(
  J+:=1;
  NBR:=CON![J+[IT-1]*6];
  IF NBR=0 DO GOTO S63;
  IF NBR=IFR DO GOTO S66;
  IF IUSED!NBR=1 DO LOOP;
  IF IUSED!NBR>1 DO GOTO S65;
  NSTAK+:=1;
  IFROM!NSTAK:=IT;
  ITO!NSTAK:=NBR;
  LOOP;
  S65: NBOND+:=1;
  NODE1!NBOND:=IT;
  NODE2!NBOND:=NBR;
  MULTIP!NBOND:=MCON![J+[IT-1]*6];
  SETRT(X!NBR#-X!IT,Y!NBR#-Y!IT,ANG+NBOND,DIST+NBOND,@TRMIN);
  LOOP;
  S66: MULTIP!NBN:=MCON![J+[IT-1]*6];
  SETRT(X!IT#-X!IFR,Y!IT#-Y!IFR,ANG+NBN,DIST+NBN,@TRMIN)
  $);
 GOTO S63;
 S105: PBPTR:=1;
 I:=0;
 WHILE I<NBOND DO $( I+:=1; DIST!I#/:=TRMIN $);
 I:=0;
 WHILE I<NBOND DO
  $(
  I+:=1;
  STAKPT:=0;
  PBPTRS!I:=PBPTR;
  ANGI:=ANG!I;
  ANGMAX:=ANGI#+DELANG;
  ANGMIN:=ANGI#-DELANG;
  J:=0;
  WHILE J<NDIREC DO
   $(
   J+:=1;
   BANGJ:=BANG!J;
   IF BANGJ #LS ANGMIN DO LOOP;
   IF BANGJ #GR ANGMAX DO BREAK;
   DEL:=#-#ABS[ANGI#-BANGJ];
   PUTSTK(POSBON+PBPTR-1,N2STAK,RSTAK,@STAKPT,BNUM!J,0,DEL)
   $);
  PBPTR+:=STAKPT+1;
  POSBON![PBPTR-1]:=0
  $);
 I:=0;
 WHILE I<NODES DO
  $(
  I+:=1;
  VALENC!I:=0;
  J:=0;
  WHILE J<8 DO $( J+:=1; BCON![J+[[I-1]<<3]]:=0 $)
  $);
 I:=0;
 WHILE I<NBOND DO
  $(
  I+:=1;
  N1:=NODE1!I;
  N2:=NODE2!I;
  IDIREC:=POSBON![PBPTRS!I];
  J:=0;
  WHILE J<6 DO
   $(
   J+:=1;
   IF ICON![J+[N1-1]*6] EQ N2 DO CON![J+[N1-1]*6]:=IDIREC;
   IF ICON![J+[N2-1]*6] EQ N1 DO CON![J+[N2-1]*6]:=IDIREC
   $);
  IV:=VALENC!N1+1;
  BCON![IV+[[N1-1]<<3]]:=I;
  VALENC!N1:=IV;
  IV:=VALENC!N2+1;
  BCON![IV+[[N2-1]<<3]]:=-I;
  VALENC!N2:=IV
  $);
 RESULTIS NBOND
 $);

LET DRWPAD(PAD,PADSIZ,NAMES) = VALOF
 $( STATIC $( LINE = VEC 80; BONCHR = TABLE 0,'-','\','|','/',
              '=','=','=','=','#','#','#','#','**','**','**','**',
              '&','&','&','&' $);
 STATIC $( LINEPT = NIL; ATNO = NIL; VAL = NIL; PSTART = NIL;
           K = NIL; PADPTR = NIL; J = NIL; LASTC = NIL;
           JMAX = NIL; I = NIL; IMAX = NIL $);
 MANIFEST $( BLANK = ' '; ATVAL = #4000000; BKSPAC = '*B' $);
 I:=0;
 WHILE I<PADSIZ DO $( I+:=1; LINE!I:=0 $);
 PADPTR:=0;
 I:=0;
 WHILE I<PADSIZ DO
  $(
  I+:=1;
  J:=0;
  WHILE J<PADSIZ DO
   $(
   J+:=1;
   PADPTR+:=1;
   IF PAD!PADPTR NE 0 DO LINE!J:=1;
   $)
  $);
 IMAX:=PADSIZ-1;
 I:=0;
 WHILE I<IMAX DO
  $(
  I+:=1;
  IF LINE!I GE LINE![I+1] DO LOOP;
  PADPTR:=I;
  GOTO S53
  $);
 IF LINE!PADSIZ=1 DO RESULTIS 0;
 PADPTR:=0;
 S53: PSTART:=PADPTR;
 I:=0;
 WHILE I<PADSIZ DO
  $(
  I+:=1;
  LINEPT:=0;
  LASTC:=0;
  JMAX:=PADSIZ;
  IF I=PADSIZ DO JMAX:=JMAX-PSTART;
  J:=0;
  WHILE J<JMAX DO
   $(
   J+:=1;
   PADPTR:=PADPTR+1;
   VAL:=PAD!PADPTR;
   IF VAL=0 DO $( LINEPT+:=1; LINE!LINEPT:=BLANK; LOOP $);
   PAD!PADPTR:=0;
   IF VAL GE ATVAL DO
    $(
    LINEPT:=LINEPT+1;
    ATNO:=VAL/ATVAL;
    LINE!LINEPT:=NAMES![2+[[ATNO-1]<<2]];
    LASTC:=LINEPT;
    LOOP
    $);
   K:=0;
   WHILE K<20 DO
    $(
    K+:=1;
    IF [VAL BITAND 1]=1 DO
     $(
     LINEPT:=LINEPT+2;
     LINE![LINEPT-1]:=BONCHR!K;
     LINE!LINEPT:=BKSPAC
     $);
    VAL:=VAL>>1
    $);
   LINEPT:=LINEPT-1;
   LASTC:=LINEPT
   $);
  IF LASTC>0 DO WRT33(LINE,LASTC)
  $)
 $);

LET DRWGEN(PAD,PADSIZ,NAMES) = VALOF
 $( STATIC $( LINE = VEC 80; LINE2 = VEC 80; LINE3 = VEC 80;
              BONCHR = TABLE 0,'-','\','|','/','=','=','=','=','#','#',
              '#','#','**','**','**','**','&','&','&','&' $);
 STATIC $( LINEPT = NIL; ATNO = NIL; L = NIL; X = NIL;
           VAL = NIL; IX = NIL; PSTART = NIL; TEMPTR = NIL;
           K = NIL; QS = NIL; Q = NIL; LPT2SV = NIL;
           MASK = NIL; BIX = NIL; PADPTR = NIL; J = NIL;
           LASTC = NIL; JMAX = NIL; WIDE = NIL; LASTC2 = NIL;
           LPT2 = NIL; DEL = NIL; I = NIL; IMAX = NIL $);
 MANIFEST $( BLANK = ' '; ATVAL = #4000000; BKSPAC = '*B';
             MASK0 = #210421; WIDTH = 71 $);
 I:=0;
 WHILE I<PADSIZ DO
  $(
  I+:=1;
  LINE!I:=0
  $);
 PADPTR:=0;
 I:=0;
 WHILE I<PADSIZ DO
  $(
  I+:=1;
  J:=0;
  WHILE J<PADSIZ DO
   $(
   J+:=1;
   PADPTR:=PADPTR+1;
   IF PAD!PADPTR NE 0 DO LINE!J:=1
   $)
  $);
 IMAX:=PADSIZ-1;
 PADPTR:=0;
 I:=0;
 WHILE I<IMAX DO
  $(
  I+:=1;
  IF LINE!I GE LINE![I+1] DO LOOP;
  PADPTR:=I;
  BREAK
  $);
 PSTART:=PADPTR;
 WIDE:=0;
 I:=0;
 WHILE I<80 DO
  $(
  I+:=1;
  IF LINE!I=1 DO WIDE:=WIDE+1
  $);
 IF WIDE>[WIDTH/3] DO RESULTIS 0;
 I:=0;
 WHILE I<80 DO
  $(
  I+:=1;
  LINE!I:=BLANK;
  LINE2!I:=BLANK;
  LINE3!I:=BLANK
  $);
 I:=0;
 WHILE I<PADSIZ DO
  $(
  I+:=1;
  LINEPT:=0;
  LPT2:=0;
  LASTC:=0;
  LASTC2:=0;
  JMAX:=PADSIZ;
  IF I=PADSIZ DO JMAX:=JMAX-PSTART;
  J:=0;
  WHILE J<JMAX DO
   $(
   J+:=1;
   PADPTR:=PADPTR+1;
   VAL:=PAD!PADPTR;
   IF VAL NE 0 DO GOTO S1;
   LINEPT:=LINEPT+3;
   LPT2:=LPT2+3;
   LOOP;
   S1: IF VAL GE ATVAL DO GOTO S2;
   MASK:=MASK0;
   DEL:=-1;
   QS:=1;
   LINEPT:=LINEPT+2;
   LPT2:=LPT2+1;
   LPT2SV:=LPT2;
   K:=1;
   WHILE K<4 DO
    $(
    K+:=1;
    MASK:=MASK*2;
    QS:=QS*2;
    Q:=QS;
    X:=VAL BITAND MASK;
    IF X=0 DO GOTO S102;
    IX:=K;
    L:=0;
    WHILE L<5 DO
     $(
     L+:=1;
     IF X=Q DO
      $(
      BIX:=BONCHR!IX;
      LINE![LINEPT+DEL]:=BIX;
      LINE3![LINEPT-DEL]:=BIX;
      LPT2+:=2;
      LINE2![LPT2-1]:=BIX;
      LINE2!LPT2:=BKSPAC;
      BREAK
      $);
     IX+:=4;
     Q:=Q<<4;
     $);
    S102: DEL+:=1;
    $);
   LINEPT+:=1;
   LASTC:=LINEPT;
   X:=VAL BITAND MASK0;
   IF X=0 DO
    $(
    LINE2!LPT2:=BLANK;
    LASTC2:=LPT2;
    LOOP
    $);
   IX:=1;
   K:=0;
   WHILE K<3 DO
    $(
    K+:=1;
    IF X=1 DO BREAK;
    IX+:=4;
    X:=X/16
    $);
   BIX:=BONCHR!IX;
   LINE2!LPT2SV:=BIX;
   LPT2+:=2;
   LINE2![LPT2-1]:=BIX;
   LINE2!LPT2:=BIX;
   LOOP;
   S2: LINEPT+:=2;
    LPT2+:=2;
   ATNO:=VAL/ATVAL;
   TEMPTR:=PADPTR+1;
   MASK:=MASK0;
   X:=PAD!TEMPTR BITAND MASK;
   IF X NE 0 DO LINE2![LPT2+1]:=BONCHR!1;
   IF I GE IMAX DO GOTO S200;
   TEMPTR+:=PADSIZ;
   MASK:=MASK*2;
   X:=PAD!TEMPTR BITAND MASK;
   IF X NE 0 DO LINE3![LINEPT+1]:=BONCHR!2;
   TEMPTR-:=1;
   MASK:=MASK*2;
   X:=PAD!TEMPTR BITAND MASK;
   IF X NE 0 DO LINE3!LINEPT:=BONCHR!3;
   TEMPTR-:=1;
   MASK:=MASK*2;
   X:=PAD!TEMPTR BITAND MASK;
   IF X NE 0 DO LINE3![LINEPT-1]:=BONCHR!4;
   S200: TEMPTR:=PADPTR-1;
   MASK:=MASK0;
   X:=PAD!TEMPTR BITAND MASK;
   IF X NE 0 DO LINE2![LPT2-1]:=BONCHR!1;
   IF I LE 2 DO GOTO S201;
   TEMPTR-:=PADSIZ;
   MASK:=MASK*2;
   X:=PAD!TEMPTR BITAND MASK;
   IF X NE 0 DO LINE![LINEPT-1]:=BONCHR!2;
   TEMPTR+:=1;
   MASK:=MASK*2;
   X:=PAD!TEMPTR BITAND MASK;
   IF X NE 0 DO LINE!LINEPT:=BONCHR!3;
   TEMPTR+:=1;
   MASK:=MASK*2;
   X:=PAD!TEMPTR BITAND MASK;
   IF X NE 0 DO LINE![LINEPT+1]:=BONCHR!4;
   S201: SWITCHON NAMES![1+[[ATNO-1]<<2]] INTO
    $(
    CASE 1:
     LINE2!LPT2:=NAMES![2+[[ATNO-1]<<2]];
     ENDCASE;
    CASE 2:
     TEST LINE2![LPT2+1] NE BLANK THEN
      $(
      LINE2![LPT2-1]:=NAMES![2+[[ATNO-1]<<2]];
      LINE2!LPT2:=NAMES![3+[[ATNO-1]<<2]]
      $)
     OR
      $(
      LINE2!LPT2:=NAMES![2+[[ATNO-1]<<2]];
      LINE2![LPT2+1]:=NAMES![3+[[ATNO-1]<<2]]
      $);
     ENDCASE;
    CASE 3:
     LINE2![LPT2-1]:=NAMES![2+[[ATNO-1]<<2]];
     LINE2!LPT2:=NAMES![3+[[ATNO-1]<<2]];
     LINE2![LPT2+1]:=NAMES![4+[[ATNO-1]<<2]];
     ENDCASE
    $);
   LINEPT+:=1;
   LPT2+:=1;
   LASTC:=LINEPT;
   LASTC2:=LPT2;
   $);
  IF LASTC=0 DO LOOP;
  WRT33(LINE,LASTC);
  WRT33(LINE2,LASTC2);
  WRT33(LINE3,LASTC);
  J:=0;
  WHILE J<LASTC DO
   $(
   J+:=1;
   LINE!J:=BLANK;
   LINE3!J:=BLANK
   $);
  J:=0;
  WHILE J<LASTC2 DO
   $(
   J+:=1;
   LINE2!J:=BLANK
   $)
  $);
 RESULTIS 1
 $);

LET TTYMOL(NODES,NAMES,ICON,X,Y,FAILED,CON) BE
 $( STATIC $( NODE1 = VEC 70; NODE2 = VEC 70; MULTIP = VEC 70;
              DIST = VEC 70; POSBON = VEC 280; PBPTRS = VEC 70;
              BCON = VEC 400; VALENC = VEC 50; PTRS = VEC 8;
              REFLCT = TABLE 0,5,6,7,8,1,2,3,4; STARY = VEC 1500;
              STPTRS = VEC 51; STATE = VEC 51; STRAT = VEC 550;
              LOC = VEC 50; VI1M1 = VEC 70; VI2M1 = VEC 70 $);
 STATIC $( YMIN = NIL; STPTR = NIL; X0 = NIL; YMAX = NIL;
           NSELKT = NIL; VNODE = NIL; NBOND = NIL; K = NIL;
           LIL = NIL; XMIN = NIL; NODE = NIL; BONDI = NIL;
           XMAX = NIL; INDEX = NIL; PADDIM = NIL; DELANG = NIL;
           J = NIL; XYTEMP = NIL; NSOLNS = NIL; Y0 = NIL;
           DIREC = NIL; BOND = NIL; I = NIL; N1 = NIL $);
 MANIFEST $( MAXSOL = 50 $);
 DELANG:=35.0;
 XMIN:=1.0E6;
 XMAX:=#-XMIN;
 YMIN:=XMIN;
 YMAX:=XMAX;
 I:=0;
 WHILE I<NODES DO
  $(
  I+:=1;
  IF X!I #LS XMIN DO XMIN:=X!I;
  IF X!I #GR XMAX DO XMAX:=X!I;
  IF Y!I #LS YMIN DO YMIN:=Y!I;
  IF Y!I #GR YMAX DO YMAX:=Y!I
  $);
 IF [YMAX#-YMIN] #GR [XMAX#-XMIN] DO
  $(
  I:=0;
  WHILE I<NODES DO
   $(
   I+:=1;
   XYTEMP:=X!I;
   X!I:=Y!I;
   Y!I:=#-XYTEMP
   $);
  XYTEMP:=XMAX;
  XMAX:=YMAX;
  YMAX:=#-XMIN;
  XMIN:=YMIN;
  YMIN:=#-XYTEMP
  $);
 S1234: !FAILED:=0;
 NBOND:=BONSET(ICON,CON,NODES,X,Y,NODE1,NODE2,MULTIP,DIST,
        POSBON,PBPTRS,BCON,VALENC,DELANG);
 X0:=X![NODE1!1]#-[XMIN#+XMAX]#/2.0;
 Y0:=Y![NODE1!1]#-[YMIN#+YMAX]#/2.0;
 STPTR:=1;
 NODE:=0;
 WHILE NODE<NODES DO
  $(
  NODE+:=1;
  STPTRS!NODE:=STPTR;
  VNODE:=VALENC!NODE;
  BONDI:=0;
  WHILE BONDI<VNODE DO
   $(
   BONDI+:=1;
   BOND:=BCON![BONDI+[[NODE-1]<<3]];
   TEST BOND>0 THEN
    $(
    PTRS!BONDI:=PBPTRS!BOND;
    VI1M1!BOND:=BONDI-1
    $)
   OR
    $(
    PTRS!BONDI:=-[PBPTRS![-BOND]];
    VI2M1![-BOND]:=BONDI-1
    $)
   $);
  NSELKT:=SELEKT(POSBON,PTRS,VNODE,STARY+STPTR-1,REFLCT);
  IF NSELKT=0 DO
   TEST DELANG #EQ 45.0 THEN $( !FAILED:=1; RETURN $)
   OR $( DELANG:=45.0; GOTO S1234 $);
  STPTR:=STPTR+NSELKT*VNODE;
  $);
 STPTRS![NODES+1]:=STPTR;
 N1:=[STPTRS![N1+1]-STPTRS!N1]/VALENC!N1;
 IF STATES(STATE,0,NBOND,NODE1,NODE2,VI1M1,
           VI2M1,STPTRS,STARY,N1,VALENC)=0 DO
  TEST DELANG #EQ 45.0 THEN $( !FAILED:=3; RETURN $)
  OR $( DELANG:=45.0; GOTO S1234 $);
 I:=0;
 WHILE I<NODES DO
  $(
  I+:=1;
  INDEX:=STPTRS!I+VALENC!I*[STATE!I-1];
  J:=0;
  WHILE J<6 DO
   $(
   J+:=1;
   BOND:=BCON![J+[[I-1]<<3]];
   IF BOND=0 DO BREAK;
   NODE:=(BOND>0 -> NODE2!BOND,NODE1![-BOND]);
   DIREC:=STARY!INDEX;
   INDEX:=INDEX+1;
   K:=0;
   WHILE K<6 DO
    $(
    K+:=1;
    IF ICON![K+[I-1]*6] EQ NODE DO CON![K+[I-1]*6]:=DIREC
    $)
   $)
  $);
 PADDIM:=OUTPAD.IPADSZ*OUTPAD.IPADSZ;
 I:=0;
 WHILE I<PADDIM DO $( I+:=1; OUTPAD.IPAD!I:=0 $);
 LIL:=1;
 I:=0;
 WHILE I<NODES DO $( I+:=1; IF NAMES![1+[[I-1]<<2]]>1 DO LIL:=0 $);
 NSOLNS:=0;
 S681: GSTRAT(STRAT,STATE,NODES,VALENC,STARY,STPTRS,
              NBOND,NODE1,NODE2,DIST,BCON);
 IF TRYDRW(STRAT,OUTPAD.IPAD,OUTPAD.IPADSZ,LOC,MULTIP,X0,Y0)=0 DO
  $(
  NSOLNS+:=1;
  IF NSOLNS LE MAXSOL DO
   IF STATES(STATE,1,NBOND,NODE1,NODE2,VI1M1,
             VI2M1,STPTRS,STARY,N1,VALENC) NE 0 DO GOTO S681;
  TEST [DELANG #EQ 45.0] BITOR [NSOLNS>9] THEN $( !FAILED:=4; RETURN $)
  OR $( DELANG:=45.0 GOTO S1234 $);
  $);
 TEST LIL=1 THEN
  IF DRWPAD(OUTPAD.IPAD,OUTPAD.IPADSZ,NAMES)=0 DO !FAILED:=4
 OR
  TEST PUTMUL(OUTPAD.IPAD,OUTPAD.IPADSZ,LOC,NAMES,NODES)=0 THEN
   IF DRWGEN(OUTPAD.IPAD,OUTPAD.IPADSZ,NAMES)=0 DO !FAILED:=4
  OR
   IF DRWPAD(OUTPAD.IPAD,OUTPAD.IPADSZ,NAMES)=0 DO !FAILED:=4
 $);

LET ORIENP(X,Y,N) BE
 $(
 STATIC $( XCM = NIL; YY = NIL; YI = NIL; A = NIL;
           XI = NIL; YCM = NIL; S = NIL; C = NIL;
           XX = NIL; XY = NIL; I = NIL $);
 XCM:=0.0;
 YCM:=0.0;
 I:=0;
 WHILE I<N DO
  $(
  I+:=1;
  XCM:=XCM#+X!I;
  YCM:=YCM#+Y!I
  $);
 XCM:=XCM#/FLOAT(N);
 YCM:=YCM#/FLOAT(N);
 XX:=0.0;
 YY:=0.0;
 XY:=0.0;
 I:=0;
 WHILE I<N DO
  $(
  I+:=1;
  XI:=X!I#-XCM;
  YI:=Y!I#-YCM;
  X!I:=XI;
  Y!I:=YI;
  XX:=XX#+XI#*XI;
  YY:=YY#+YI#*YI;
  XY:=XY#+XI#*YI
  $);
 TEST YY #LE XX DO
  $(
  A:=XY#/XX;
  C:=1.0#/SQRT(1.0#+A#*A);
  S:=A#*C
  $)
 OR
  $(
  A:=XY#/YY;
  S:=1.0#/SQRT(1.0#+A#*A);
  C:=A#*S
  $);
 I:=0;
 WHILE I<N DO
  $(
  I+:=1;
  XI:=X!I;
  YI:=Y!I;
  X!I:=C#*XI#+S#*YI;
  Y!I:=#-S#*XI#+C#*YI
  $)
 $);

LET ORIENT(X,Y,Z,N,LAXIS) BE
 $(
 STATIC $( O33 = NIL; YZ = NIL; XCM = NIL; ZI = NIL;
           O32 = NIL; O31 = NIL; B = NIL; AX = NIL;
           O22 = NIL; RY = NIL; IBEST = NIL; BBY = NIL;
           RZ = NIL; O21 = NIL; YY = NIL; FNORM1 = NIL;
           FNORM2 = NIL; FAC = NIL; O23 = NIL; XZ = NIL;
           BZ = NIL; YI = NIL; ZCM = NIL; RX = NIL;
           A = NIL; O11 = NIL; O13 = NIL; O12 = NIL;
           FNORM3 = NIL; AZ = NIL; XI = NIL; ASQP1 = NIL;
           ZZ = NIL; YCM = NIL; AAY = NIL; XX = NIL;
           BX = NIL; XY = NIL; RBEST = NIL; I = NIL $);
 XCM:=0.0;
 YCM:=0.0;
 ZCM:=0.0;
 I:=1;
 WHILE I<N DO
  $(
  I+:=1;
  XCM:=XCM#+X!I;
  YCM:=YCM#+Y!I;
  ZCM:=ZCM#+Z!I;
  $);
 FAC:=1.0#/FLOAT(N);
 XCM:=XCM#*FAC;
 YCM:=YCM#*FAC;
 ZCM:=ZCM#*FAC;
 XX:=0.0;
 YY:=0.0;
 ZZ:=0.0;
 XY:=0.0;
 XZ:=0.0;
 YZ:=0.0;
 I:=0;
 WHILE I<N DO
  $(
  I+:=1;
  XI:=X!I#-XCM;
  YI:=Y!I#-YCM;
  ZI:=Z!I#-ZCM;
  X!I:=XI;
  Y!I:=YI;
  Z!I:=ZI;
  XX:=XX#+XI#*XI;
  YY:=YY#+YI#*YI;
  ZZ:=ZZ#+ZI#*ZI;
  XY:=XY#+XI#*YI;
  XZ:=XZ#+XI#*ZI;
  YZ:=YZ#+YI#*ZI;
  $);
 IBEST:=1;
 RBEST:=#-1.0;
 PLANE(XX,YY,ZZ,XY,XZ,YZ,@AZ,@BZ,@RZ,@RBEST,2,@IBEST);
 PLANE(XX,ZZ,YY,XZ,XY,YZ,@AAY,@BBY,@RY,@RBEST,3,@IBEST);
 PLANE(YY,ZZ,XX,YZ,XY,XZ,@AX,@BX,@RX,@RBEST,4,@IBEST);
 !LAXIS:=5-IBEST;
 SWITCHON IBEST INTO
  $(
  CASE 1:
   RETURN;
   ENDCASE;
  CASE 2:
   A:=AZ;
   B:=BZ;
   O11:=1.0;
   O12:=0.0;
   O13:=A;
   O21:=#-A#*B;
   O22:=1.0#+A#*A;
   O23:=B;
   O31:=#-A;
   O32:=#-B;
   O33:=1.0;
   ASQP1:=O22;
   ENDCASE;
  CASE 3:
   A:=AAY;
   B:=BBY;
   O11:=1.0;
   O12:=A;
   O13:=0.0;
   O21:=#-A#*B;
   O22:=B;
   O23:=1.0#+A#*A;
   O31:=#-A;
   O32:=1.0;
   O33:=#-B;
   ASQP1:=O23;
   ENDCASE;
  CASE 4:
   A:=AX;
   B:=BX;
   O11:=A;
   O12:=1.0;
   O13:=0.0;
   O21:=B;
   O22:=#-A#*B;
   O23:=1.0#+A#*A;
   O31:=1.0;
   O32:=#-A;
   O33:=#-B;
   ASQP1:=O23
  $);
 FNORM1:=1.0#/SQRT(ASQP1);
 FNORM3:=1.0#/SQRT(ASQP1#+B#*B);
 FNORM2:=FNORM1#*FNORM3;
 O11:=O11#*FNORM1;
 O12:=O12#*FNORM1;
 O13:=O13#*FNORM1;
 O21:=O21#*FNORM2;
 O22:=O22#*FNORM2;
 O23:=O23#*FNORM2;
 O31:=O31#*FNORM3;
 O32:=O32#*FNORM3;
 O33:=O33#*FNORM3;
 I:=0;
 WHILE I<N DO
  $(
  I+:=1;
  XI:=X!I;
  YI:=Y!I;
  ZI:=Z!I;
  X!I:=O11#*XI#+O12#*YI#+O13#*ZI;
  Y!I:=O21#*XI#+O22#*YI#+O23#*ZI;
  Z!I:=O31#*XI#+O32#*YI#+O33#*ZI;
  $)
 $);

LET TDMOL(NAT,NAMES,ICON,X,Y,IDCON) BE
 $( STATIC $( IM = VEC 50; JM = VEC 50; ICHAR = TABLE 0,1,2,4,8,
              1,2,4,8,16,32,64,128,16,32,64,128,256,512,1024,2048,
              256,512,1024,2048,#10000,#20000,#40000,#100000,#10000,
              #20000,#40000,#100000,#200000,#400000,#1000000,#2000000,
              #200000,#400000,#1000000,#2000000 $);
 STATIC $( YMIN = NIL; YMAX = NIL; NNAT = NIL; YFAC = NIL;
           ICIK = NIL; ICODE = NIL; IMI = NIL; FAC = NIL;
           XMIN = NIL; YI = NIL; XMAX = NIL; INDEX = NIL;
           XFAC = NIL; J = NIL; JMAX = NIL; XI = NIL;
           K = NIL; ICIJ = NIL; MATSSQ = NIL; I = NIL;
           JMI = NIL $);
 MANIFEST $( IATVAL = #4000000; IOFF = 8 $);
 LET MSZ,MATOUT=OUTPAD.IPADSZ,OUTPAD.IPAD;
 IF MSZ>43 DO MSZ:=43;
 MATSSQ:=MSZ*MSZ;
 I:=0;
 WHILE I<MATSSQ DO $( I+:=1; MATOUT!I:=0 $);
 XMIN:=1.0E20;
 XMAX:=#-XMIN;
 YMIN:=XMIN;
 YMAX:=XMAX;
 I:=0;
 WHILE I<NAT DO
  $(
  I+:=1;
  XI:=X!I;;
  YI:=Y!I;
  IF XI #LS XMIN DO XMIN:=XI;
  IF XI #GR XMAX DO XMAX:=XI;
  IF YI #LS YMIN DO YMIN:=YI;
  IF YI #GR YMAX DO YMAX:=YI
  $);
 XFAC:=FLOAT(MSZ-4)#/[XMAX#-XMIN];
 YFAC:=FLOAT(MSZ-4)#/[YMAX#-YMIN];
 FAC:=YFAC;
 IF XFAC #LS YFAC DO FAC:=XFAC;
 IF FAC #GR 5.0 DO FAC:=5.0;
 NNAT:=NAT;
 I:=0;
 WHILE I<NAT DO
  $(
  I+:=1;
  IMI:=1+FIX([X!I#-XMIN]#*FAC);
  JMI:=1+FIX([Y!I#-YMIN]#*FAC);
  IM!I:=IMI;
  JM!I:=JMI;
  INDEX:=IMI+MSZ*[JMI-1];
  JMAX:=1+NAMES![1+[[I-1]<<2]];
  MATOUT!INDEX:=I*IATVAL;
  IF JMAX #EQ 2 DO LOOP;
  INDEX-:=2;
  J:=2;
  WHILE J<JMAX DO
   $(
   J+:=1;
   NNAT+:=1;
   NAMES![2+[[NNAT-1]<<2]]:=NAMES![J+[[I-1]<<2]];
   MATOUT![INDEX+J]:=NNAT*IATVAL
   $)
  $);
 I:=0;
 WHILE I<NAT DO
  $(
  I+:=1;
  J:=0;
  WHILE J<6 DO
   $(
   J+:=1;
   ICIJ:=ICON![J+[I-1]*6];
   IF ICIJ=0 DO BREAK;
   IF ICIJ<I DO LOOP;
   ICODE:=IDCON![J+[I-1]*6]-IOFF;
   K:=0;
   WHILE K<6 DO
    $(
    K+:=1;
    ICIK:=ICON![K+[I-1]*6];
    IF ICIK=0 DO BREAK;
    IF ICIK=ICIJ DO ICODE:=ICODE+IOFF
    $);
   TGLIN(MATOUT,MSZ,ICHAR!ICODE,IM!I,JM!I,IM!ICIJ,JM!ICIJ)
   $)
  $);
 DRWPAD(MATOUT,MSZ,NAMES)
 $);

LET DRAW(ICON,NAT,NAMES) BE
 $( STATIC $( X = VEC 50; Y = VEC 50; Z = VEC 50; ITOP = VEC 1025;
              DX = VEC 50; DY = VEC 50; DZ = VEC 50; IDCON = VEC 300;
              XSAV = VEC 50; YSAV = VEC 50; BCHARS = TABLE 0,'-','=',
              '#','**','&','$'; IDSAV = VEC 300 $);
 STATIC $( MAX = NIL; RMINIM = NIL; KFLAT = NIL; ZI = NIL;
           DXI = NIL; DELY = NIL; DZI = NIL; LAXIS = NIL;
           NBOND = NIL; IFAIL = NIL; FAC = NIL; N = NIL;
           YI = NIL; INDEX = NIL; IM = NIL; DELX = NIL;
           FDEL = NIL; J = NIL; XI = NIL; CRIT = NIL;
           DYI = NIL; DELZ = NIL; I = NIL; JIX = NIL;
           ITER = NIL $);
 MANIFEST $( MAXIT = 101; DELTA = 0.35; RMIN = 0.001; RMAX = 1.0;
             RMIN2 = 0.001 $);
 STATIC $( ALPHA = -0.3; BETA = 0.000001; GAMMA = 0.2;
           REGS = VEC #17; REGSP17 = NIL; REGSP16 = NIL $);
 MANIFEST $( R.I = 1; R.J = 2; R.INDEX = 3; R.XI = 4; R.YI = 5;
             R.ZI = 6; R.DXI = 7; R.DYI = #10; R.DZI = #11;
             R.DELX = #12; R.DELY = #13; R.DELZ = #14; R.FAC = #15;
             R.FDEL = #16 $);
 REGSP17:=REGS+#17;
 REGSP16:=REGS+#16;
 IF NAT=2 DO
  $(
  NBOND:=0;
  I:=0;
  WHILE I<6 DO $( I+:=1; IF ICON!I=0 DO BREAK; NBOND+:=1 $);
  MAX:=NAMES!1+1;
  I:=1;
  WHILE I<MAX DO $( I+:=1; OUTCH(NAMES!I) $);
  OUTCH(BCHARS!NBOND);
  MAX:=NAMES!5+5;
  I:=5;
  WHILE I<MAX DO $( I+:=1; OUTCH(NAMES!I) $);
  NEWLINE(1);
  RETURN
  $);
 I:=0;
 WHILE I<NAT DO $( I+:=1; X!I:=0.0; Y!I:=0.0; Z!I:=0.0 $);
 IF 0=SETUP(NAT,ICON,ITOP,X,Y,Z) DO
  $(
  TTYMOL(NAT,NAMES,ICON,X,Y,@IFAIL,IDCON);
  IF IFAIL=0 DO RETURN
  $);
 N:=NAT;
 KFLAT:=0;
 RMINIM:=RMIN;
 S778: ITER:=0;
 S100: ITER+:=1;
 IF ITER GE MAXIT DO GOTO S112;
 I:=0;
 WHILE I<N DO $( I+:=1; DX!I:=0.0; DY!I:=0.0; DZ!I:=0.0 $);
// INDEX:=0;
// I:=1;
// WHILE I<N DO
//  $(
//  I+:=1;
//  XI:=X!I;
//  YI:=Y!I;
//  ZI:=Z!I;
//  DXI:=0.0;
//  DYI:=0.0;
//  DZI:=0.0;
//  IM:=I-1;
//  J:=0;
//  WHILE J<IM DO
//   $(
//   J+:=1;
//   INDEX:=INDEX+1;
//   DELX:=X!J#-XI;
//   DELY:=Y!J#-YI;
//   DELZ:=(KFLAT=1 -> 0.0,Z!J#-ZI);
//   FAC:=DELX#*DELX#+DELY#*DELY#+DELZ#*DELZ#+BETA;
//   TEST ITOP!INDEX>0 THEN FAC:=GAMMA#-GAMMA#/FAC
//   OR FAC:=ALPHA#/FAC#*FAC;
//   FDEL:=FAC#*DELX;
//   DXI#+:=FDEL;
//   DX!J#-:=FDEL;
//   FDEL:=FAC#*DELY;
//   DYI#+:=FDEL;
//   DY!J#-:=FDEL;
//   FDEL:=FAC#*DELZ;
//   DZI#+:=FDEL;
//   DZ!J#-:=FDEL
//   $);
//  DX!I#+:=DXI;
//  DY!I#+:=DYI;
//  DZ!I#+:=DZI
//  $);
 $[ $MOVEM #17,@REGSP17;
    $MOVE #17,REGS;
    $BLT #17,@REGSP16;
    $MOVNI R.INDEX,1026;
    $HRRZI R.I,1;
    $SUB R.I,N;
    $MOVS R.I,R.I;
    $HRRI R.I,-49;
LPI:$MOVE R.XI,X(R.I);
    $MOVE R.YI,Y(R.I);
    $MOVE R.ZI,Z(R.I);
    $SETZM 0,R.DXI;
    $SETZM 0,R.DYI;
    $SETZM 0,R.DZI;
    $HRRZI R.J,-50;
    $SUB R.J,R.I;
    $MOVS R.J,R.J;
    $HRRI R.J,-50;
LPJ:$AOJ R.INDEX,0;
    $MOVE R.DELX,R.XI;
    $FSBR R.DELX,X(R.J);
    $MOVE R.DELY,R.YI;
    $FSBR R.DELY,Y(R.J);
    $SKIPE 0,KFLAT;
    $JRST 0,NEZ;
    $MOVE R.DELZ,R.ZI;
    $FSBR R.DELZ,Z(R.J);
    $CAIA 0,0;
NEZ:$SETZM 0,R.DELZ;
    $MOVE R.FAC,R.DELX;
    $FMPR R.FAC,R.FAC;
    $MOVE R.FDEL,R.DELY;
    $FMPR R.FDEL,R.FDEL;
    $FADR R.FAC,R.FDEL;
    $MOVE R.FDEL,R.DELZ;
    $FMPR R.FDEL,R.FDEL;
    $FADR R.FAC,R.FDEL;
    $FADR R.FAC,BETA;
    $SKIPG 0,ITOP(R.INDEX);
    $JRST 0,BO0;
    $MOVE R.FDEL,GAMMA;
    $FDVR R.FDEL,R.FAC;
    $MOVE R.FAC,GAMMA;
    $FSBR R.FAC,R.FDEL;
    $JRST 0,DLT;
BO0:$MOVE R.FDEL,R.FAC;
    $FMPR R.FDEL,R.FDEL;
    $MOVE R.FAC,ALPHA;
    $FDVR R.FAC,R.FDEL;
DLT:$MOVE R.FDEL,R.FAC;
    $FMPR R.FDEL,R.DELX;
    $FSBR R.DXI,R.FDEL;
    $FADRM R.FDEL,DX(R.J);
    $MOVE R.FDEL,R.FAC;
    $FMPR R.FDEL,R.DELY;
    $FSBR R.DYI,R.FDEL;
    $FADRM R.FDEL,DY(R.J);
    $FMPR R.FAC,R.DELZ;
    $FSBR R.DZI,R.FAC;
    $FADRM R.FAC,DZ(R.J);
    $AOBJN R.J,LPJ;
    $FADRM R.DXI,DX(R.I);
    $FADRM R.DYI,DY(R.I);
    $FADRM R.DZI,DZ(R.I);
    $AOBJN R.I,LPI;
    $HRLZ #17,REGS;
    $BLT #17,#17;
 $];
 CRIT:=0.0;
// I:=0;
// WHILE I<N DO $( I+:=1; CRIT#+:=DX!I#*DX!I#+DY!I#*DY!I#+DZ!I#*DZ!I $);
 $[ $MOVN R.I,N;
    $MOVS R.I,R.I;
    $HRRI R.I,-50;
LP2:$MOVE R.J,DX(R.I);
    $FMPR R.J,R.J;
    $FADRM R.J,CRIT;
    $MOVE R.J,DY(R.I);
    $FMPR R.J,R.J;
    $FADRM R.J,CRIT;
    $MOVE R.J,DZ(R.I);
    $FMPR R.J,R.J;
    $FADRM R.J,CRIT;
    $AOBJN R.I,LP2
 $];
 CRIT:=SQRT(CRIT#/FLOAT(N));
 IF CRIT #GR RMINIM DO
  $(
  I:=0;
  TEST CRIT #GR RMAX THEN
   $(
   FAC:=RMAX#/CRIT;
   WHILE I<N DO
    $(
    I+:=1;
    X!I#+:=FAC#*DX!I;
    Y!I#+:=FAC#*DY!I;
    Z!I#+:=FAC#*DZ!I
    $)
   $)
  OR
   WHILE I<N DO
    $(
    I+:=1;
    X!I#+:=DX!I;
    Y!I#+:=DY!I;
    Z!I#+:=DZ!I
    $);
  GOTO S100
  $);
 S112: IF KFLAT=0 DO
  $(
  KFLAT:=1;
  RMINIM:=RMIN2;
  LAXIS:=4;
  ORIENT(X,Y,Z,N,@LAXIS);
  IF LAXIS NE 4 DO ORIENT(X,Y,Z,N,LAXIS);
  GOTO S778
  $);
 ORIENP(X,Y,N);
 ORIENP(X,Y,N);
 S1135: TTYMOL(NAT,NAMES,ICON,X,Y,@IFAIL,IDCON);
 IF IFAIL=0 DO RETURN;
 IF KFLAT=1 DO
  $(
  KFLAT:=2;
  I:=0;
  WHILE I<NAT DO
   $(
   I+:=1;
   XSAV!I:=X!I;
   YSAV!I:=Y!I;
   J:=0;
   WHILE J<6 DO
    $(
    J+:=1;
    JIX:=J+6*[I-1];
    IDSAV!JIX:=IDCON!JIX
    $);
   X!I#+:=0.5#*Z!I
   $);
  GOTO S1135
  $);
 TDMOL(NAT,NAMES,ICON,XSAV,YSAV,IDSAV)
 $);

LET SKIPLINES(N) BE
 WHILE N>0 DO $( N:=N-1; UNTIL INCH()='*C' DO; INCH() $);

LET MAIN() BE
 $( STATIC $( INNAME = VEC 3; LINE = VEC 160; NAMES = VEC 200;
              NAMES2 = VEC 200; ICON = VEC 300; ICON2 = VEC 300;
              IUSED = VEC 50; ICOMPO = VEC 50; ISTAK = VEC 50 $);
 //ALF3/82 -- ADDITION FOR COMPACTING CONNECTION TABLE
 STATIC $( CTNUM = VEC 50; RENUMB = VEC 200 $);
 STATIC $( INJ = NIL; MAX = NIL; IPTR = NIL; IC3 = NIL;
           NAT2 = NIL; IDUM = NIL; NODE = NIL; NNN = NIL;
           NBR = NIL; IC1 = NIL; J = NIL; NAT = NIL;
           NCHAR = NIL; IXNBR = NIL; IVLNC = NIL; NEWNUM = NIL;
           I4 = NIL; I = NIL; IC2 = NIL; IMAX = NIL;
           IPADSZ = NIL $);
 MANIFEST $( IBLANK = ' '; IATOM = ' ' $);
 STATIC $( IEND = TABLE 0,'E','N','D','$' $);
 MANIFEST $( MAXAT = 50; MAXIN = 50 $)
 TRMTYP.NTERM:=1;
// NTERM = 1 ASSUMES THAT THE TERMINAL HAS VERTICAL-BAR CHARACTERS
//            AND PHYSICAL BACKSPACE (FOR CROSSING BOND SYMBOLS)
//        = 2 USES EXCLAIMATION POINT RATHER THAN VERTICAL BAR AND
//            USES LINE-OVERPRINTING RATHER THAN BACKSPACE FOR CROSSING
//            BONDS (PRIMARILY FOR MODEL33 TELETYPES)
//        = 3 ASSUMES A GT40 IS BEING USED (THIS BYPASSES MUCH OF THE
//            TTY-SPECIFIC CODE)(NOT YET IMPLEMENTED)
// NOTE - THE FUNCTIONS INRUPT, CLOS1 AND QUIT STILL REMAIN
// FROM AN OLDER IMPLEMENTATION, AS DO THE COMMON BLOCK INTRPT
// AND THE VARIABLE INTFLG.  THESE HAVE NO EFFECT IN THIS VERSION
 INFILE:=FINDFILE("DSK",SC1FILENAME(),CGEXT);
 INPUT:=INFILE;
 READRETURN();
 OUTPUT:=TTY;
 IPADSZ:=63;
 INRUPT(@INTRPT.INTFLG);
 NEWLINE(1);
 S777: NAT:=INNON(5);
 INCH();INCH();
 IF NAT LE -1000 DO GOTO S999;
 IF INTRPT.INTFLG NE 0 DO QUIT();
 IF NAT<0 DO $( TRMTYP.NTERM:=-NAT; GOTO S777 $);
 IF NAT>MAXIN DO $( SKIPLINES(NAT); NAT:=-1; GOTO S800 $);
 I:=0;
 WHILE I<MAXIN DO $( I+:=1; IUSED!I:=1 $);
 IF NAT=0 DO GOTO S800;
 FOR J = 0 TO 200 DO RENUMB!J := 0				//ALF3/82
 IDUM:=0;							//ALF3/82
 WHILE IDUM<NAT DO
  $(
  IDUM+:=1;							//ALF3/82
  CTNUM!IDUM:=INNON(3);						//ALF3/82
  RENUMB!(CTNUM!IDUM) := IDUM					//ALF3/82
  INNAME!1:=INCH();
  INNAME!2:=INCH();
  INNAME!3:=INCH();
  UNLESS INNONL(3,6,ICON+6*[IDUM-1]) DO
   $( SKIPLINES(NAT-IDUM); NAT:=-2; GOTO S800 $);		//ALF3/82
  IF INTRPT.INTFLG NE 0 DO QUIT();
  IUSED!IDUM:=0;
  I:=[IDUM-1]<<2;						//ALF3/82
  NCHAR:=1;
  J:=0;
  WHILE J<3 DO
   $(
   J+:=1;
   INJ:=INNAME!J;
   IF INJ=' ' DO LOOP;
   NCHAR+:=1;
   NAMES![NCHAR+I]:=INJ						//ALF3/82
   $);
  IF NCHAR=1 DO $( NAMES![2+I]:=IATOM; NCHAR+:=1 $);		//ALF3/82
  NAMES![1+I]:=NCHAR-1;						//ALF3/82
  $);
 FOR J = 0 TO 300 DO ICON!J := RENUMB!(ICON!J)			//ALF3/82
 S800: INJ:=INCH();
 IMAX:=0;
 WHILE INJ NE '*C' DO $( IMAX+:=1; LINE!IMAX:=INJ; INJ:=INCH() $);
 INCH();
 IF INTRPT.INTFLG NE 0 DO QUIT();
 I:=0;
 WHILE I<4 DO $( I+:=1; IF LINE!I NE IEND!I DO GOTO S801 $);
 IF IMAX>0 DO GOTO S8051;
 S801: I:=0;
 WHILE I<IMAX DO $( I+:=1; OUTCH(LINE!I) $);
 NEWLINE(1);
 IF INTRPT.INTFLG NE 0 DO QUIT();
 GOTO S800;
 S8051: IF NAT=0 DO GOTO S777;
 IF NAT<0 DO $( OUTS("I CAN'T DRAW THIS ONE!*C*L*C*L"); GOTO S777 $);
 IF NAT>MAXAT DO GOTO S8054;
 I:=0;
 WHILE I<MAXIN DO
  $(
  I+:=1;
  IF IUSED!I=1 DO LOOP;
  IVLNC:=0;
  J:=0;
  WHILE J<6 DO
   $(
   J+:=1;
   IF ICON![J+6*[I-1]]=0 DO BREAK;
   IVLNC:=J
   $);
  IF IVLNC>6 DO GOTO S8054;
  $);
 GOTO S806;
 S8054: OUTS("*C*LATOM# NAME NEIGHBORS*C*L");
 IF INTRPT.INTFLG NE 0 DO QUIT();
 I:=0;
 WHILE I<MAXIN DO
  $(
  I+:=1;
  IF IUSED!I=1 DO LOOP;
  I4:=[I-1]<<2;
  IC1:=IBLANK;
  IC2:=IBLANK;
  IC3:=IBLANK;
  NNN:=NAMES![1+I4];
  IF NNN GE 1 DO IC1:=NAMES![2+I4];
  IF NNN GE 2 DO IC2:=NAMES![3+I4];
  IF NNN EQ 3 DO IC3:=NAMES![4+I4];
  IVLNC:=0;
  J:=0;
  WHILE J<20 DO $( J+:=1; IF ICON![J+I4]=0 DO BREAK; IVLNC:=J $);
  OUTNON(4,I);
  SPACES(3);
  OUTCH(IC1);
  OUTCH(IC2);
  OUTCH(IC3);
  SPACES(3);
  J:=0;
  WHILE J<IVLNC DO $( J+:=1; OUTNON(4,ICON![J+I4]) $);
  NEWLINE(1);
  IF INTRPT.INTFLG NE 0 DO QUIT()
  $);
 GOTO S777;
 S806: NAT2:=0;
 I:=0;
 WHILE I<MAXAT DO $( I+:=1; ICOMPO!I:=0 $);
 I:=0;
 WHILE I<MAXAT DO $( I+:=1; J:=I; IF IUSED!I=0 DO GOTO S5 $);
 GOTO S777;
 S5: IPTR:=2;
 ISTAK!1:=J;
 ICOMPO!J:=1;
 IUSED!J:=1;
 NAT2:=1;
 WHILE IPTR>1 DO
  $(
  IPTR-:=1;
  NODE:=ISTAK!IPTR;
  IXNBR:=0;
  WHILE IXNBR<6 DO
   $(
   IXNBR+:=1;
   NBR:=ICON![IXNBR+[NODE-1]*6];
   IF NBR=0 DO BREAK;
   IF ICOMPO!NBR NE 0 DO LOOP;
   NAT2+:=1;
   ICOMPO!NBR:=NAT2;
   IUSED!NBR:=1;
   ISTAK!IPTR:=NBR;
   IPTR+:=1
   $)
  $);
 NODE:=0;
 WHILE NODE<MAXAT DO
  $(
  NODE+:=1;
  NEWNUM:=ICOMPO!NODE;
  IF NEWNUM=0 DO LOOP;
  IXNBR:=0;
  WHILE IXNBR<6 DO
   $(
   IXNBR+:=1;
   NBR:=ICON![IXNBR+[NODE-1]*6];
   IF NBR NE 0 DO NBR:=ICOMPO!NBR;
   ICON2![IXNBR+[NEWNUM-1]*6]:=NBR;
   IF IXNBR LE 4 DO
    NAMES2![IXNBR+[[NEWNUM-1]<<2]]:=NAMES![IXNBR+[[NODE-1]<<2]]
   $)
  $);
 TEST NAT2>1 THEN DRAW(ICON2,NAT2,NAMES2)
 OR
  $(
  MAX:=NAMES2!1+1;
  I:=1;
  WHILE I<MAX DO $( I+:=1;  OUTCH(NAMES2!I); $);
  NEWLINE(1)
  $);
 NEWLINE(1);
 GOTO S806;
 S999: ENDREAD(INPUT);
 EXECUTERETURN()
 $);

STATIC $( VECSPACE = VEC 1000 $);
LET START() BE
 $(
// ![#124]:=TOPORSTOP;
 INITIALISEIO(VECSPACE,1000);
 OUTPUT:=TTY;
 INPUT:=TTY;
 RECINIT();
 MAIN()
 $)
